SuperHack/SuperHack CD.bin/CODING/MISC/KINGV3.ZIP/KMAGUNIT.PAS

Pascal/Delphi Source File | 1996-01-11 | 10.5 KB | 386 lines

{THE KING MAGAZINE UNIT FOR PASCAL          }
{WRITING BY THE KING IN 01/02/96            }
Unit KMagUnit;
Interface
Uses Dos;


Type
{A Picture Type}
    PicType = Array[0..64000] Of Byte;     {Pointer To The Pictures}
    PicTypeP = ^PicType;
{Red , Green , Blue Type}
    RGB = Record                           {A Record Of Red,Green,Blue}
        R,G,B:Byte;
    End;
{Palette Type}
    PalType = Array[0..255] Of RGB;        {256 Color Of Red Green Blue}

{Mouse Button Types}
    ButtonType = (None,Left,Right,LeftRight);

{Mouse Type}
    MouseType = Record
        X,Y:Word;
        Buttons : ButtonType;
    End;

{Cel Format Header}
    CelHeader=Record                {A Cel File Header}
        Sign:Word;
        W,H:Word;
        X,Y:Word;
        Depth:Byte;
        Compress:Byte;
        Data:LongInt;
        Filler:Array[1..16] OF Byte;
        Pal:PalType;
     End;

Var
    Keys : Array[1..128] Of Boolean;  {The Keys status}
    Mouse:MouseType;


{-------------------Set Modes Routines-----------------}

Procedure SetMode;
Procedure SetTextMode;

{-------------------Graphics Routines------------------}

Procedure PutPixel(X,Y:Integer;Col:Byte);
Procedure ShowPic(Pic:PicTypeP);

{--------------------Palette Routines-------------------}

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Procedure SetColor(Col:Byte;R,G,B:Byte);
Procedure ShowPal(Var Pal:PalType);
Procedure GetPal(Var Pal:PalType);
Procedure FadeTo(Pal,ToPal:PalType);

{----------------------File Formats---------------------}

Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;

{------------------------Effects------------------------}

Procedure MakeCrossFade(Pic1,Pic2:PicTypeP;Var Pic3:PicTypeP;
                        Var PalP1,PalP2,PalCp1,PalCp2:PalType);

{-------------------KeyBoard Routines-------------------}

Procedure InitKeyBoard;
Procedure RestoreKeyBoard;

{------------------------------Mouse Routines------------------------------}

Function ResetMouse:Boolean;
Procedure GetMouse(Var Mouse:MouseType);
Procedure ShowMouse;
Procedure HideMouse;

Implementation

Var
    OldInt9 : Procedure;
{-----------------------------Set Modes Routines---------------------------}

{------------------------------------------------}
{Set Mode To Mode 13H , 320x200x256 Colors..     }
{------------------------------------------------}

Procedure SetMode;Assembler;
Asm
       Mov Ah,00h  {Function 00,13 Interrupt 10h / SET MODE}
    Mov Al,13h
    Int 10h     {SETING TO MODE 13H}
End;

{------------------------------------------------}
{Set Mode To Mode 3H , 80x25x16 Colors..         }
{------------------------------------------------}
Procedure SetTextMode;Assembler;
Asm
    Mov Ah,00h {Function 00,3 Interrupt 10h / SET MODE}
    Mov Al,3h
    Int 10h    {SET MODE TO MODE 3 / TEXT MODE}
End;

{----------------------------Graphics Routines-----------------------------}

{------------------------------------------------}
{Plot a single pixel on the screen .             }
{------------------------------------------------}
Procedure PutPixel(X,Y:Integer;Col:Byte);Assembler;
Asm
    Mov Ax,0a000h     {Ax = SEGMENT OF THE SCREEN}
    Mov Es,Ax         {Es = SEGMENT OF THE SCREEN}
    Mov Ax,320        {Ax = MAX VERTICAL LINE}
    Mul Y             {Ax = AX * Y = HORIZONTAL LINE}
    Add Ax,X          {Ax = VERTICAL LINE + HORIZONTAL LINE = OFFSET}
    Mov Di,Ax         {DI = OFFSET}
    Mov Al,Col        {AL = COLOR}
    StoSb             {[0A000h:OFFSET] = COLOR}
End;

{-----------------------------------------}
{ Show Picture On Screen .                }
{-----------------------------------------}

Procedure ShowPic(Pic:PicTypeP);Assembler;
  Asm
    Push Ds
    Mov Ax,Word(Pic+2)                {Take The Segment Of Pic}
    Mov Ds,Ax
    Xor Si,Si                         {Si = 0}
    Mov Ax,0a000h
    Mov Es,Ax
    Xor Di,Di                         {Di = 0}
    Mov Cx,32000                      {32000*2 = 64000}
    Rep MovSw                         {Move 32000*2 Bytes}
    Pop Ds
 End;

{------------------------------Palette Routines----------------------------}

{-------------------------------------------------------}
{Get Red Green And Blue From a Color                    }
{-------------------------------------------------------}

Procedure GetColor(Col:Byte;Var R,G,B:Byte);Assembler;
ASM
    Mov Dx,3c7H                  {Set To GET COLOR}
    Mov Al,Col
    Out Dx,Al
    Inc Dx                       {Dx = 3c8H}
    Inc Dx                       {Dx = 3c9H}
    Les Di,R                     {Es:Di = R}
    In Al,Dx                     {Get Red Value}
    Mov [Es:Di],Al               {R = Red Value}
    In Al,Dx                     {Get Green Value}
    Les Di,G                     {Es:Di = G}
    Mov [Es:Di],Al               {G = Green Value}
    In Al,Dx                     {Get Blue Value}
    Les Di,B                     {Es:Di = B}
    Mov [Es:Di],Al               {B = Blue Value}
END;

{-------------------------------------------------------}
{Set Red Green And Blue To a Color                      }
{-------------------------------------------------------}

Procedure SetColor(Col:Byte;R,G,B:Byte);Assembler;
Asm
    Mov Dx,3c8h                  {SET TO SET COLOR}
    Mov Al,Col
    Out Dx,Al
    Inc Dx                       {DX = 3c9h}
    Mov Al,R                     {Senting Red Value}
    Out Dx,Al
    Mov Al,G                     {Senting Green Value}
    Out Dx,Al
    Mov Al,B                     {Senting Blue Value}
    Out Dx,Al
End;
{---------------------------------------------------}
{ Show The Palette                                  }
{---------------------------------------------------}
Procedure ShowPal(Var Pal:PalType);
Var T:Byte;
Begin
    For T:=0 To 255 Do
        SetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;
{---------------------------------------------------}
{ Get The Use Palette From The Screen               }
{---------------------------------------------------}

Procedure GetPal(Var Pal:PalType);
Var T:Byte;
Begin
    For T:=0 To 255 Do
        GetColor(T,Pal[T].R,Pal[T].G,Pal[T].B);
End;

{---------------------------------------------------}
{ Fade To The Screen From Palette To Palette.       }
{---------------------------------------------------}
Procedure FadeTo(Pal,ToPal:PalType);
Var
    T,T1:Byte;
Begin
    For T1:=1 To 63 Do
    Begin
        For T:=1 To 255 Do
        Begin
            If Pal[T].R > ToPal[T].R Then
                Dec(Pal[T].R);
            If Pal[T].R < ToPal[T].R Then
                Inc(Pal[T].R);
            If Pal[T].G > ToPal[T].G Then
                Dec(Pal[T].G);
            If Pal[T].G < ToPal[T].G Then
                Inc(Pal[T].G);
            If Pal[T].B > ToPal[T].B Then
                Dec(Pal[T].B);
            If Pal[T].B < ToPal[T].B Then
                Inc(Pal[T].B);
        End;
        ShowPal(Pal);
    End;
End;
{-------------------------------File Formats-------------------------------}

Function LoadCel(Name:String;Var Where;Var Pal:PalType):Boolean;
Var F:File;
    Cel:CelHeader;
Begin
    {$I-}
    Assign(F,Name);
    Reset(F,1);
    {$I+}
    If IoResult=0 Then
        Begin
            LoadCel:=True;
            BlockRead(F,Cel,SizeOf(Cel));
            BlockRead(F,Where,FileSize(F)-SizeOf(Cel));
            Pal:=Cel.Pal;
            Close(F);
        End
        Else
        Begin
            LoadCel:=False;
        End;
End;

{---------------------------------Effects----------------------------------}

{---------------------------------------------}
{Build The Picture Of The Cross Fade          }
{---------------------------------------------}

Procedure MakeCrossFade(Pic1,Pic2:PicTypeP;Var Pic3:PicTypeP;
                        Var PalP1,PalP2,PalCp1,PalCp2:PalType);
Var
    Colors : Array[0..255] Of Record
        Pix1,Pix2:Byte;
End;
    T:Word;
    T1:Word;
    Num:Word;
    Pix1,Pix2:Byte;
Begin
    T:=0;
    Num := 1;
    Repeat
        Pix1 := PIC1^[T];
        Pix2 := PIC2^[T];
        For T1 := 0 To Num - 1 Do
        Begin
            If (Num <> 1) And (Pix1=Colors[T1].Pix1) And (Pix2=Colors[T1].Pix2) Then
            Begin
                PIC1^[T] := T1;
                T1:=256;
                Break;
            End
        End;

        If T1 <> 256 Then
        Begin
              PIC1^[T] := Num;
            PalCP1[Num] := PalP1[Pix1];
            PalCP2[Num] := PalP2[Pix2];
            Colors[Num].Pix1 := Pix1;
            Colors[Num].Pix2 := Pix2;
            Num := Num + 1;
        End;
        Inc(T);
        If Num > 255 Then
        Begin
            Writeln('More Then 256 Colors . ');
            Halt;
        End;
    Until(T=64000);
End;

{-----------------------------Keyboard Routines------------------------------}

{--------------------------------------------}
{New Interrupt 9 for handle with the keyboard}
{--------------------------------------------}


Procedure NewInt9;interrupt;
Begin
    Keys[Port[$60] Mod 128] := (Port[$60] < 128) ;
    {Checking if Port[$60] < 128 , If He Is , Keys[Port[$60] Mod 128]
    Is True Else False}
    Asm
        PushF                       {Pushing Flags}
    End;
    OldInt9;                        {Calling the old interrupt}
    Mem[$0040:$001A] := Mem[$0040:$001C];
    {Puting The Tail And The Head , for clear the buffer}
End;

{-------------------------------------------}
{         Init The new interrupt            }
{-------------------------------------------}

Procedure InitKeyboard;
Begin
    GetIntVec($9,@OldInt9);
    SetIntVec($9,@NewInt9);
End;

{--------------------------------------}
{      Restore The Old interrupt       }
{--------------------------------------}
Procedure RestoreKeyBoard;
Begin
    SetIntVec($9,@OldInt9);
End;

{------------------------------Mouse Routines------------------------------}

{--------------------------------------}
{         Get the mouse status         }
{--------------------------------------}

Procedure GetMouse(Var Mouse:MouseType);Assembler;
    Asm
        Push Ds                 {Saving DS}
        Mov Ax,0003h            {Function 0003H INT 33H GET STATUS}
        Int 33h
        Lds Si,Mouse            {[DS:SI] = MOUSE}
        Shr CX,3                {FOR DIVIDE IT WITH 8}
        Shr DX,3
        Mov [Ds:Si],CX          {[DS:SI] = X = CX}
        Mov [Ds:Si+2],DX        {[DS:SI+2] = Y = DX}
        Mov [DS:Si+4],BX        {[DS:SI+4] = BUTTON = BX}
        Pop Ds                  {Restoring DS}
    End;

{Thus function Reseting the mouse and return true if the mouse is installed}
Function ResetMouse:Boolean;Assembler;
Asm
    Mov Ax,0000h
    Int 33h
End;

{Show the mouse on the screen}
Procedure ShowMouse;Assembler;
Asm
    Mov Ax,0001h
    Int 33h
End;
{Hide the mouse from the screen}
Procedure HideMouse;Assembler;
Asm
    Mov Ax,0002h
    Int 33h
End;

End.